#!/usr/bin/perl -wc

package RFCMail::ESMTP::Server::base;

use strict;
use warnings;


sub command_mode {
    my ($self) = @_;
    my ($line) = $self->get_line($self->{timeout});
    if (not defined($line)) {
	$self->logmsg(i => "client closed connection: performing implicit quit");
	return (621);
    }
    return ($self->reply($self->command($line)));
}


sub data_mode {
    my ($self) = @_;
    my $line;
    while (1) {
	$line = $self->get_line($self->{timeout});
	if (not defined($line)) {
	    # End-of-file encountered
	    $self->logmsg(n => "client closed connection during DATA phase");
	    return (621);
	}
	if ($line eq '.') {
	    # End-of-data marker encountered
	    $self->{mode} = 'command_mode';
	    my $reply = $self->data_finish;
	    if ($reply->[0] == 250) {
		$self->data_commit;
	    }
	    else {
		$self->data_abort;
	    }
	    return ($self->reply($reply));
	}
	# An ordinary data line -- perform dot-unstuffing if needs be
	substr $line, 0, 1, ""
	    if $line =~ /^\./;
	$self->data_line($line);
	$self->{state}->{data_lines}++;
    }
}


sub command {
    my ($self, $line) = @_;
    my $reply;
    if (defined($self->{halt})) {
	$reply = [421, split(/\n+/, $self->{halt})];
    }
    elsif ($line =~ /[\200-\377]/) {
	$reply = [500, "Syntax error: illegal characters in data"];
    }
    else {
	my ($method, @parms) = $self->{handlers}->parse_line($line);
	$reply = $self->$method(@parms);
    }
    return ($reply);
}


sub reply {
    my ($self, $reply) = @_;
    my ($code, @blurb) = @$reply;
    # Convert to 421 if reply does not pass syntax checks.
    eval {
	die "attempted to send inappropriate reply code '$code'"
	    if $code !~ /\A[1-5][0-5]\d\Z/;
	die "attempted to send code $code with no accompanying text"
	    if not @blurb;
	for (@blurb) {
	    die "attempted to send illegal character in reply text"
		if tr/\012\015\200-\377//;
	}
    };
    if ($@) {
	$self->logmsg(c => "reply() failed: $@");
	$self->logmsg(i => "performing server-initiated quit (Bug!)");
	$code = 421;
	@blurb = ("Internal server error: closing connection");
    }
    # Insert domain in front of text for x2x codes.
    if ($code =~ /^.2./) {
	$blurb[0] = $self->{domain}." ".$blurb[0];
    }
    # Send the reply.
    my $last = pop @blurb;
    $self->reply_lines(map("$code-$_", @blurb), "$code $last");
    return ($code);
}


sub reply_lines {
    my $self = shift;
    $self->put(join($self->{eol}, @_).$self->{eol});
}


1;
